home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 33 / 033.d81 / jig is up (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  5KB  |  179 lines
  1. 1 dim nt(8,8)
  2. 10 :
  3. 20 print"[147][144]":poke53280,6:poke53281,5
  4. 30 for cl=54272to54296:poke cl,0:next cl:rem clear sonic adresses
  5. 40 print "             the jig is up"
  6. 50 print"                  by
  7. 60 [153]"         paul g. mulvaney, iii
  8. 70 print"      "
  9. 80 print"             type preference:"
  10. 90 print"           jigs(j) or reels(r)"
  11. 92 print:print"      press 'q' at any time to quit"
  12. 95 ag$="please wait while i compose your "
  13. 100 get i$: if i$="j"goto140
  14. 110 ifi$="r"goto130
  15. 115 ifi$="q"then60000
  16. 120 goto100
  17. 130 s=8:t$="reel.": goto150
  18. 140 s=6:t$="jig."
  19. 150 print"[147]";
  20. 151 z=z+1:print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":print" "ag$t$
  21. 152 print" [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
  22. 160 for b=1to8
  23. 165 print""spc(19)8-b
  24. 170 for n=1tos
  25. 175 ifpeek(198)<>0thengeta$:ifa$="q"then20
  26. 180 rem********************************
  27. 190 kl=0:rem prevents endless loop
  28. 200 kl=kl+1:ifkl=25then160
  29. 210 nt(b,n)=int(rnd(0)*15+1):ifb*n<8*sthengoto290:rem note generator & last note
  30. 220 rem********************************
  31. 230 rem lines24-26 put last note in tonic chord
  32. 240 ifnt(8,s)=nt(4,s)orabs(nt(8,s)-nt(4,s))=2orabs(nt(8,s)-nt(4,s))=4then320
  33. 250 ifabs(nt(8,s)-nt(4,s))=7then320
  34. 260 goto200
  35. 270 rem*********************************
  36. 280 rem line 29 repeats opening theme
  37. 290 nt(5,n)=nt(1,n):nt(6,n)=nt(2,n)
  38. 300 rem********************************
  39. 310 rem lines 32-34 disallow huge intervals other than octaves
  40. 320 ifabs(nt(b,n)-nt(b,n-1))=7then500
  41. 330 kl=kl+1:ifkl=25then160:rem antilock
  42. 340 ifabs(nt(b,n)-nt(b,n-1))>4goto200
  43. 350 rem*********************************
  44. 360 rem lines 37-43 create chords 20% of the time
  45. 370 ifn=sgoto500
  46. 380 ifnt(b,n)=1goto1020
  47. 390 ifnt(b,n)=15goto1070
  48. 400 nq=int(rnd(0)*30+1):onnqgoto500,500,500,500,500,500,500,500,500
  49. 410 onnq-9goto880,900,920,940,960,980
  50. 420 onnq-15goto500,500,500,500,500,500,500,500
  51. 430 onnq-23goto500,500,500,500,500,500,500
  52. 440 rem*********************************
  53. 450 rem lines46-49 keep chord progressions in range of tinwhistle (&array!)
  54. 460 if nt(b,n)>15thennt(b,n)=nt(b,n)-7
  55. 470 ifnt(b,n)<1thennt(b,n)=nt(b,n)+7
  56. 480 if nt(b,n+1)<1thennt(b,n+1)=nt(b,n+1)+7
  57. 490 if nt(b,n+1)>15thennt(b,n+1)=nt(b,n+1)-7
  58. 500 next n
  59. 510 nextb
  60. 515 print"[147]";:mm=0
  61. 520 rem********************************
  62. 530 rem lines 54-67 play tune 2x
  63. 540 fortw=1to2
  64. 550 forb=1to8
  65. 560 forn=1tos
  66. 570 onnt(b,n)goto710,720,730,740,750
  67. 580 onnt(b,n)-5goto760,770,780,790,800
  68. 590 onnt(b,n)-10goto810,820,830,840,850
  69. 600 poke54296,15:poke54277,136:poke54278,136:poke54276,17
  70. 610 if(mm=.)and(s=6)thenprint,
  71. 615 poke54273,h:poke54272,l:printn$,:mm=mm+1:ifmm=3thenmm=0
  72. 620 if n/s=int(n/s)thenprint"--------------------------------------":goto640
  73. 630 if2*n/s=int(2*n/s)thenprint"......................................."
  74. 640 forqt=1to15:nextqt:poke54276,16
  75. 645 ifpeek(198)<>0thengeta$:ifa$="q"then20
  76. 650 nextn
  77. 660 nextb
  78. 670 nexttw
  79. 680 gosub1140
  80. 690 goto150
  81. 700 rem note assignments***************
  82. 710 n$="d":h=9:l=104:goto600
  83. 720 n$="e":h=10:l=143:goto600
  84. 730 n$="f#":h=11:l=218:goto600
  85. 740 n$="g":h=12:l=143:goto600
  86. 750 n$="a":h=14:l=24:goto600
  87. 760 n$="b":h=15:l=210:goto600
  88. 770 n$="c#":h=17:l=195:goto600
  89. 780 n$="d^":h=18:l=209:goto600
  90. 790 n$="e^":h=21:l=31:goto600
  91. 800 n$="f#^":h=23:l=181:goto600
  92. 810 n$="g^":h=25:l=30:goto600
  93. 820 n$="a^":h=28:l=49:goto600
  94. 830 n$="b^":h=31:l=165:goto600
  95. 840 n$="c#^":h=35:l=134:goto600
  96. 850 n$="d^^":h=37:l=162:goto600
  97. 860 rem********************************
  98. 870 rem 6 ways to play a diatonic chord, chosen randomly at line 41
  99. 880 nt(b,n)=nt(b,n-1)+2
  100. 890 nt(b,n+1)=nt(b,n)+2:goto460
  101. 900 nt(b,n)=nt(b,n-1)+4
  102. 910 nt(b,n+1)=nt(b,n)-2:goto460
  103. 920 nt(b,n)=nt(b,n-1)+2
  104. 930 nt(b,n+1)=nt(b,n)-4:goto460
  105. 940 nt(b,n)=nt(b,n-1)-2
  106. 950 nt(b,n+1)=nt(b,n)+4:goto460
  107. 960 nt(b,n)=nt(b,n-1)-2
  108. 970 nt(b,n+1)=nt(b,n)-2:goto460
  109. 980 nt(b,n)=nt(b,n-1)-4
  110. 990 nt(b,n+1)=nt(b,n)+2:goto460
  111. 1000 rem********************************
  112. 1010 rem special cases for "d" chords
  113. 1020 ifn>(s-2)goto500
  114. 1030 qn=int(rnd(0)*10+1):onqngoto500,500,500,500,500
  115. 1040 onqn-5goto500,500,500,1050,1060
  116. 1050 nt(b,n+1)=nt(b,n)+2:nt(b,n+2)=nt(b,n)+4:goto500
  117. 1060 nt(b,n+1)=nt(b,n)+4:nt(b,n+2)=nt(b,n)+2:goto500
  118. 1070 ifn>(s-2)goto500
  119. 1080 qq=int(rnd(0)*10+1):onqqgoto500,500,500,500,500
  120. 1090 onqq-5goto500,500,500,1100,1110
  121. 1100 nt(b,n+1)=nt(b,n)-4:nt(b,n+2)=nt(b,n)-2:goto500
  122. 1110 nt(b,n+1)=nt(b,n)-2:nt(b,n+2)=nt(b,n)-4:goto500
  123. 1120 rem********************************
  124. 1130 rem printer option with timer loop
  125. 1140 ifs=6goto1160
  126. 1150 ifs=8thenprint"printout this fine reel?":goto1170
  127. 1160 print" printout this lovely jig?"
  128. 1170 print"answer 'y'(yes) or 'n'(no), 'q' quits":forzt=1to1000
  129. 1180 get p$:ifp$="y"then1220
  130. 1190 if p$="n"then1520
  131. 1195 ifp$="q"then20
  132. 1200 next zt
  133. 1210 goto1520
  134. 1220 open15,4,15:close15:ifst<>0thengosub50000:p$="n":goto1190
  135. 1225 open4,4:print#4,chr$(14);t$;z;chr$(15)
  136. 1230 forb=1to8
  137. 1240 forn=1tos
  138. 1250 on nt(b,n) goto1360,1370,1380,1390,1400
  139. 1260 on nt(b,n)-5goto1410,1420,1430,1440,1450
  140. 1270 on nt(b,n)-10goto1460,1470,1480,1490,1500
  141. 1280 print#4,n$,
  142. 1290 if n/s=int(n/s)thenprint#4,"                                    "
  143. 1300 ifn/s=int(n/s)then print#4,"--------------------------------------":goto1330
  144. 1310 if2*n/s=int(2*n/s)thenprint#4,"                                    "
  145. 1320 if2*n/s=int(2*n/s)then print#4,"......................................."
  146. 1330 ifn*b=s*8goto1510
  147. 1340 nextn
  148. 1350 nextb
  149. 1360 n$="d":goto1280
  150. 1370 n$="e":goto1280
  151. 1380 n$="f#":goto1280
  152. 1390 n$="g":goto1280
  153. 1400 n$="a":goto1280
  154. 1410 n$="b":goto1280
  155. 1420 n$="c#":goto1280
  156. 1430 n$="d^":goto1280
  157. 1440 n$="e^":goto1280
  158. 1450 n$="f#^":goto1280
  159. 1460 n$="g^":goto1280
  160. 1470 n$="a^":goto1280
  161. 1480 n$="b^":goto1280
  162. 1490 n$="c#^":goto1280
  163. 1500 n$="d^^":goto1280
  164. 1510 close4
  165. 1520 return
  166. 50000 rem no printer
  167. 50010 print"[147]"spc(10)"printer not on-line..."
  168. 50020 fordl=1to3000:next:return
  169. 50030 :
  170. 60000 rem quit
  171. 60010 print"[147] do you really want to quit?"
  172. 60020 poke198,0:wait198,1:geta$:ifa$<>"y"anda$<>"n"then60010
  173. 60030 ifa$="n"then20
  174. 60040 :
  175. 60050 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  176. 60060 ifer<>63thenend
  177. 60070 load"hello connect",8
  178. 60080 end
  179.